home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / TestRTLIUnit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-06  |  2.7 KB  |  128 lines
  1. unit TestRTLIUnit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     Panel1: TPanel;
  13.     ShowBtn: TButton;
  14.     RawCheckBox: TCheckBox;
  15.     procedure ShowBtnClick(Sender: TObject);
  16.   private
  17.     procedure Five;
  18.     procedure Four;
  19.   end;
  20.  
  21. var
  22.   Form1: TForm1;
  23.  
  24. implementation
  25.  
  26. {$R *.DFM}
  27.  
  28. uses
  29.   LiPrgInt,
  30.   HVYAST32;
  31.  
  32. function StackDumpStr: string;
  33. var
  34.   i: integer;
  35.   LocInfo: TLocInfo;
  36. begin
  37.   Result := '';
  38.   if not RTLIAvailable then
  39.     Result := '(NO RTLI AVAILABLE!)'#13#10;
  40.  
  41.   Result := Result +
  42.             'Stackframe-based trace:'#13#10+
  43.             'Physical Logical  Unit                (######) Routine';
  44.   for i := 0 to StackDumpCount-1 do
  45.     with StackDump[i] do
  46.     begin
  47.       GetLocationInfo(Pointer(CallerAdr), LocInfo);
  48.       if LocInfo.liLineNo <> 0 then
  49.         Result := Format('%s'#13#10'%.8x %.8x %20s (%5d) %s.%s',
  50.           [Result, DWORD(CallerAdr), PhysicalToLogical(DWORD(CallerAdr)),
  51.             LocInfo.liFileName, LocInfo.liLineNo, LocInfo.liUnitName, LocInfo.liPubSym1Name])
  52.       else
  53.         Result := Format('%s'#13#10'%.8x %.8x %s.%s',
  54.           [Result, DWORD(CallerAdr), PhysicalToLogical(DWORD(CallerAdr)),
  55.             LocInfo.liUnitName, LocInfo.liPubSym1Name]);
  56.     end;
  57. end;
  58.  
  59. {$W+} { Make sure the compiler generates stack frames for the following routines }
  60.  
  61. procedure One;
  62. var
  63.   Trace: string;
  64. begin
  65.   { Generate a stack trace, skipping no levels
  66.     The stack trace will be saved in the global StackDump array }
  67.   SaveStackTrace(Form1.RawCheckBox.Checked, 0, nil);
  68.   Trace := StackDumpStr;
  69.  
  70.   { Now report the contents of the StackDump array into the memo }
  71.   Form1.Memo1.Lines.Clear;
  72.   Form1.Memo1.Lines.Add(Trace);
  73. end;
  74.  
  75. procedure Two;
  76. begin
  77.   { OOPS! The compiler does not crate a stack-frame
  78.     for all-assembly routines like this one. }
  79.   asm
  80.     { Create a default stack frame manually }
  81.     PUSH EBP
  82.     MOV  EBP, ESP
  83.  
  84.     { Simulate a CALL instruction using PUSH and RET }
  85.     PUSH OFFSET @@ret_addr
  86.     PUSH OFFSET One
  87.     RET
  88.  
  89.     { After the 'call' we get back here }
  90. @@ret_addr:
  91.  
  92.     { Clean up the stack frame }
  93.     POP EBP
  94.   end;
  95. end;
  96.  
  97. procedure Three;
  98. begin
  99.   { Normal procedure call }
  100.   Two;
  101. end;
  102.  
  103. procedure TForm1.Four;
  104. var
  105.   ProcVarCall: procedure;
  106. begin
  107.   { Call through a procedure variable }
  108.   ProcVarCall := Three;
  109.   ProcVarCall;
  110. end;
  111.  
  112. procedure TForm1.Five;
  113. var
  114.   EventCall: procedure of object;
  115. begin
  116.   { Call through an event or method variable }
  117.   EventCall := Four;
  118.   EventCall;
  119. end;
  120.  
  121. procedure TForm1.ShowBtnClick(Sender: TObject);
  122. begin
  123.   { Normal method call }
  124.   Five;
  125. end;
  126.  
  127. end.
  128.